home *** CD-ROM | disk | FTP | other *** search
/ Compendium Deluxe 1 / LSD Compendium Deluxe 1.iso / a / programming / arexx / arexg10c.lha / ARexxGuide / ARx_Reg.rexx < prev    next >
Encoding:
OS/2 REXX Batch file  |  1993-10-14  |  6.7 KB  |  220 lines
  1. /* $VER: 1.1    ARx_Reg.rexx by robin evans  (26 May 1993) */
  2. /*
  3. ** Produces a registration form and prompts user for input.
  4. ** Helpfully modified by Dean Adams. Thanks, Dean.
  5. */
  6.  
  7.  
  8. csi='9b'x;f.slant=csi'3m'; f.bold=csi'1m'; f.norm=csi'0m'
  9.              f.black=csi'31m'; f.white=csi'32m'; f.blue=csi'33m'
  10.              f.lf = '0a'x; f.cls = csi'0;0H'csi'J'
  11. /*
  12.  * NO CURSOR
  13.  */
  14. f.nc=csi'302070'x
  15.  
  16. options prompt f.blue||'::: 'f.black
  17. say f.blue'Setting up prompts...'f.black
  18.  
  19. NumPrompts = SetPrompts()
  20.  
  21. call writech STDOUT, f.cls
  22. do i = 1 to NumPrompts
  23.     say f.blue||PROMPT.i.6Prompt
  24.     say f.white'Please enter' PROMPT.i':'
  25.     parse pull Entry.i
  26. end
  27.  
  28.     say f.lf||f.white||f.cls'You entered:'||f.lf||f.black
  29.     do j = 1 to NumPrompts
  30.         call WordWrap Entry.j, 63, f.blue||right(j,2)'.)'f.black'  ', 6, 'STDOUT'
  31.         /*
  32.         DivPos = lastpos(' ', Entry.j' ', 62) + 1
  33.         say f.blue||right(j,2)'.)'f.black'   'left(Entry.j, DivPos)
  34.         do while DivPos <= length(Entry.j)
  35.             EndPos = lastpos(' ',Entry.j' ', DivPos + 63)
  36.             say '       'substr(Entry.j, DivPos, EndPos-DivPos)
  37.             DivPos = EndPos + 1
  38.         end
  39.         */
  40.     end
  41.  
  42.     do forever        /* Leave on result of prompt below */
  43.         say f.white'Would you like to change something? (Y/N)'
  44.         pull ChangeResp
  45.         if abbrev(ChangeResp, 'N') then leave
  46.         if abbrev(ChangeResp, 'Y') then do
  47.             say f.white||'Enter the number of the item to be changed:'
  48.             pull ChNum
  49.             if datatype(ChNum, N) & ChNum < NumPrompts then do
  50.                 say '            'Entry.ChNum
  51.                 say f.blue||PROMPT.ChNum.6Prompt
  52.                 say f.white'Please enter ' PROMPT.ChNum':'
  53.                 parse pull Entry.ChNum
  54.             end
  55.             else
  56.                 say 'Invalid input.'
  57.         end
  58.         else
  59.             say f.black'    Please enter Y or N'f.lf
  60.     end
  61.  
  62.     FileName = ''
  63.         /* Keep repeating the prompt until recognizable response is obtained */
  64.     do until verify(left(Dest,1), 'PFQ') = 0
  65.         say '0a'x'Save file to Printer or File?'
  66.         say 'Enter <P> for Printer or <F> for File.' f.blue'Enter <Q> to quit'
  67.  
  68.         pull Dest
  69.         if abbrev(Dest, 'P') then
  70.             FileName = 'PRT:'
  71.         else if abbrev(Dest, 'F') then
  72.             FileName = GetFile()
  73.                 /* Give the prompt again until the response is correct */
  74.     end
  75.     if FileName > '' then do
  76.             /* Save the information */
  77.         if open(.OFile, FileName, W) then do
  78.             call writeln(.OFile, '0a0a0a'x || '      Send this form and registration fee to')
  79.             call writeln(.OFile, copies(' ',40)'Robin Evans')
  80.             call writeln(.OFile, copies(' ',40)'1020 Seneca St. #405')
  81.             call writeln(.OFile, copies(' ',40)'Seattle WA  98101-2720')
  82.             call writeln(.OFile, '0a0a'x||copies(' ',6)'REGISTERED USER:')
  83.             do i = 1 to 7
  84.                 call writeln(.OFile, copies(' ',16)Entry.i)
  85.             end
  86.             if Entry.8 = 1 then amount = '$15.00'
  87.             else                amount = '$21.00'
  88.             call writeln(.OFile, '0a'x||copies(' ',6)'Enclosed is' Amount 'to register ARexxGuide.')
  89.             call writeln(.OFile, '0a0a'x||copies(' ',2)'MACHINE INFORMATION:')
  90.             do i = 9 to 12
  91.                 call writeln(.OFile, right(Prompt.i,31)'  'Entry.i)
  92.             end
  93.             parse version . Ver Proc .
  94.             if Proc = 68070 then Proc = 68040
  95.             call writeln(.OFile, right('Processor',31)'  'Proc)
  96.             call writeln(.OFile, '0a0a'x||copies(' ',4)'ARexx INFORMATION:')
  97.             call writeln(.OFile, right('ARexx version',31)'  'Ver)
  98.             do i = 13 to NumPrompts - 1
  99.                 call writeln(.OFile, right(Prompt.i,31)'  'Entry.i)
  100.             end
  101.             call writeln(.OFile, '0a0a'x||copies(' ',6)'COMMENTS:')
  102.             call WordWrap Entry.NumPrompts, 73, '        ', 8, .OFile
  103.             say f.cls||f.black'The registration form has been saved to' FileName'.'
  104.             say f.lf'Thank you very much for registering.'
  105.         end
  106.     end
  107.     else do
  108.         say f.cls||f.blue'Hmm.' f.black'I hope we didn''t run into some problem on that.'
  109.         say 'I hope you''ll consider registering even if I didn''t get this'
  110.         say 'little thing quite right.'
  111.         say f.white'By the way: This was set up to use rexxarplib.library if it''s'
  112.         say 'available. Otherwise, a far less friendly window is opened for'
  113.         say 'the file request.'
  114.         say '                  '  f.black'Thanks.'
  115.     end
  116.     options prompt f.lf||f.blue||f.nc'   Press <Enter>'f.norm
  117.     pull .
  118.  
  119. exit 0
  120.  
  121. WordWrap: procedure
  122.     parse arg Line, Length, Heading, Tab, File
  123.     DivPos = lastpos(' ', Line' ', Length) + 1
  124.     call writeln(File, Heading || left(Line, DivPos))
  125.     do while DivPos <= length(Line)
  126.         EndPos = lastpos(' ',Line' ', DivPos + Length+1)
  127.         call writeln(File, copies(' ', Tab) || substr(Line, DivPos, EndPos-DivPos))
  128.         DivPos = EndPos + 1
  129.     end
  130.  
  131. return
  132.  
  133. /*
  134.  * It would be more efficient to set the values directly by
  135.  * a series of assignments. It's both faster and more complex
  136.  * but this provides an example of how in-line data can be read
  137.  * from the program code.
  138.  */
  139.  
  140. SetPrompts: procedure expose RegType. Prompt.
  141.  
  142.     Prompt. = ''
  143.     RegType.1 = '$15.00 Basic registration'
  144.     RegType.2 = '$21.00 Premium registration'
  145.     PNum = 0
  146.     do i = GetLine() by 2
  147.         PNum = PNum + 1
  148.         parse value sourceline(i) with Prompt.PNum
  149.         if Prompt.PNum = '*/' then leave
  150.         parse value sourceline(i+1) with ICode Text
  151.         if ICode = 'Int' then
  152.             interpret 'Prompt.PNum.6Prompt = 'Text
  153.         else
  154.             Prompt.PNum.6Prompt = Text
  155.     end
  156.     return PNum-1
  157.  
  158.     /* See the note to the function SOURCELINE() for an explanation of **
  159.     ** this technique for copying data from the script                 */
  160. SendLine:
  161.     return SIGL + 2
  162. GetLine:
  163.     signal SendLine
  164. /*
  165. Name
  166. .   Enter your full name.
  167. Street Address
  168. .   Include suite/apartment number
  169. City
  170. .   Enter your city only.
  171. State/Province
  172. .   Enter the 2-char. code
  173. Zip/Postal Code
  174.  
  175. Country
  176. .   Enter your country
  177. Network address
  178. .   Enter E-mail address and name of network
  179. Registration level (1 or 2)
  180. Int '   1.)' RegType.1'0a'x'   2.)' RegType.2', including printed guide.'
  181. Model number
  182. .   Examples: 500, or 1200, or 2000HD
  183. Chip memory
  184. .   Examples: 500K, 1M, 2M, 3M
  185. Fast memory
  186. .   Examples: 0K, 1M, 8M
  187. Hard drive size
  188. .   Examples: 0M, 40M, 120M, 240M
  189. time using ARexx
  190. Int '0a'x'   The following questions concern your level'||'0a'x'   of ARexx expertise.'
  191. your skill level
  192. .   Examples: Expert, Beginner, Novice
  193. programs used with ARexx
  194. Int '0a'x'Include the names of any programs for'||'0a'x'which you will use ARexx to write macros.'
  195. comments about the guide
  196. Int '   Continue typing past the end of line.'||'0a'x'   Text will be wrapped afterwards.'
  197. */
  198.  
  199. GetFile:    procedure expose f.    /* make formatting codes global for syntax: */
  200.         /* If rexxarplib isn't available, this will call syntax:, which **
  201.         ** will ask for a file less politely                            */
  202.     call addlib('rexxarplib.library',0,-30,0)
  203.     signal on syntax
  204.     return 'GetFile'(60,20,,,'Save registration form as:',,PATGAD,,,300)
  205.  
  206.  
  207. Syntax:
  208.     signal off syntax
  209.     call remlib('rexxarplib.library')
  210.     if open(.FWin, 'con:0/8/400/77', W) then do
  211.         call writeln(.FWin, f.blue'Sorry. We couldn''t open a file requester.')
  212.         call writeln(.FWin, f.white'Please enter full path of file.'||'0a'x)
  213.         call writech(.FWin, f.black'File: ')
  214.         FileN = readln(.FWin)
  215.         call close .FWin
  216.         return FileN
  217.     end
  218.     else
  219.         return ''
  220.